package MLB::Web;

# Copyright 2008 Ted Romer
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License,
# version 2.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

use strict;
use warnings;

use Carp;
use Data::Dumper;
use Exporter::Lite;
use HTTP::Cookies;
use HTTP::Request::Common;
use URI::Escape;

our @EXPORT = qw(connect_request
                 login_request
                 process_login_response
                 miniscoreboard_request
                 games_by_date_request
                 game_detail_request
                 get_media_id_from_raw_uri
                 authorized_media_request
                 get_media_uri_from_authorized_media_response
                 );

sub connect_request {
    my $uri =
        'https://secure.mlb.com/enterworkflow.do' .
        '?flowId=registration.wizard&c_id=mlb';
    return GET $uri;
}

sub login_request {
    my $args = shift;

    my $post_args = {
        uri => '/account/login_register.jsp',
        registrationAction => 'identify',
        emailAddress       => $args->{emailAddress},
        password           => $args->{password},
    };

    my $uri = 'https://secure.mlb.com/authenticate.do';
    return POST $uri, $post_args;
}

#
# Return auth state -- true on auth success, false on failure
# 
sub process_login_response {
    my $response = shift;
    my %flags;
    if ( @_ % 2 == 0 ) {
        %flags = @_;
    }
    my $debug = $flags{debug};

    my $success = 0;
    my $failure = 0;

    my $cookie_jar = HTTP::Cookies->new();
    $cookie_jar->extract_cookies($response);
    my %cookies;
    $cookie_jar->scan(sub {
        $cookies{$_[1]} = $_[2];
    });
    if ( $debug ) {
        print STDERR "Cookies set: " . join(" ",keys(%cookies)) . "\n";
    }
    if ( defined($cookies{ipid}) ||
         defined($cookies{fprt}) ||
         defined($cookies{appacc}) ) {
        $success = 1;
    } 
    my $title = $response->header('Title');
    if ( $debug ) {
        print STDERR "Title: $title\n";
    }
    if (defined($title) && $title =~ m/Account: Account Management$/) {
        $success = 1;
    }
    my $session_cookie = $cookies{SESSION_1};
    my $parsed_session_cookie = {};
    if ( defined($session_cookie) ) {
        $parsed_session_cookie = _parse_session_cookie($session_cookie);
        if ( $debug ) {
            print STDERR "Session cookie contains keys: " .
                join(" ",keys(%$parsed_session_cookie)) . "\n";
        }
    }
    if ( defined($parsed_session_cookie->{identityPoint}) ) {
        $success = 1;
    }

    if (defined($title) &&
        $title =~ m@Account: Account Management.*Login/Register@) {
        $failure = 1;
    }
    if ( defined($parsed_session_cookie->{flowId}) ) {

        $failure = 1;
    }

    my $auth_status;
    if ( !($success xor $failure) ) {
        warn("Succeeded and failed");
        $auth_status = 1;  # Err on the side of success
    } else {
        $auth_status = $success;
    }
    
    return $auth_status;
}

sub miniscoreboard_request {
    my $args = shift;
    my $y = $args->{y};
    my $m = $args->{m};
    my $d = $args->{d};
    if ( !defined($y) || !defined($m) || !defined ($d) ) {
        croak("Must provide y, m, d");
    }
    if ( $y < 1000 || $y > 9999 || $m < 1 || $m > 12 || $d < 1 || $d > 31 ) {
        croak("Invalid date y=$y m=$m d=$d");
    }

    my $uri = sprintf "http://gd2.mlb.com/components/game/mlb/year_%04d/month_%02d/day_%02d/miniscoreboard.xml", $y, $m, $d;

    return GET $uri;
}

sub games_by_date_request {
    my $args = shift;
    my $y = $args->{y};
    my $m = $args->{m};
    my $d = $args->{d};
    if ( !defined($y) || !defined($m) || !defined ($d) ) {
        croak("Must provide y, m, d");
    }
    if ( $y < 1000 || $y > 9999 || $m < 1 || $m > 12 || $d < 1 || $d > 31 ) {
        croak("Invalid date y=$y m=$m d=$d");
    }

    my $uri = sprintf "http://mlb.mlb.com/components/game/year_%04d/month_%02d/day_%02d/gamesbydate.xml", $y, $m, $d;

    return GET $uri;
}

sub game_detail_request {
    my $id = shift;

    if ( !defined($id) ) {
        croak("Must provide id");
    }

    my ($y, $m, $d, $away, $home, $number) = $id =~ m/(^\d{4})_(\d{2})_(\d{2})_([[:alnum:]]+)_([[:alnum:]]+)_(\d+)/;

    if ( !defined($y) || !defined($m) || !defined ($d) ||
         !defined($away) || !defined($home) || !defined ($number) 
         ) {
        croak("id must have form <y>_<m>_<d>_<away>_<home>_<number>");
    }
    
    if ( $y < 1000 || $y > 9999 || $m < 1 || $m > 12 || $d < 1 || $d > 31 ) {
        croak("Invalid date y=$y m=$m d=$d");
    }

    my $uri = sprintf "http://mlb.mlb.com/components/game/year_%04d/month_%02d/day_%02d/gid_%s/gamedetail.xml", $y, $m, $d, $id;

    my $req = GET $uri;
    return $req;
}

# Given the value of an 'url' element in the game details,
# get the media id 
sub get_media_id_from_raw_uri {
    my $raw_uri = shift;
    my ($content_json) = $raw_uri =~ m/playMedia2\s*\(\s*{(.*)}\s*\)/;
    my @pairs = split(',',$content_json);
    my $map = {};
    for my $pair (@pairs) {
        my ($k, $v) = split(':',$pair,2);
        $k =~ s/^\s*//;
        $k =~ s/\s$//;
        eval "\$map->{\$k} = $v";
    }
    return $map->{id};
}

sub authorized_media_request {
    my $media_id = shift;

    my $uri = 'http://www.mlb.com/enterworkflow.do?flowId=media.media&keepWfParams=true&mediaId=' . $media_id . '&catCode=mlb_ga&av=a';
    return GET $uri;
}

sub get_media_uri_from_authorized_media_response {
    my $response = shift;

    my $cookie_jar = HTTP::Cookies->new();
    $cookie_jar->extract_cookies($response);
    my %cookies;
    $cookie_jar->scan(sub {
        $cookies{$_[1]} = $_[2];
    });

    my $session_cookie = $cookies{SESSION_1};
    croak("Failed to find set-cookie: SESSION_1=")
        if !defined($session_cookie);

    # Now we parse the cookie in all its glory.
    my $parsed_session_cookie = _parse_session_cookie($session_cookie);

    return $parsed_session_cookie->{'mUrl'};
}

# Get val of cookie and return a hash
sub _parse_session_cookie {
    my $val = shift;
    my %parsed_session_cookie = ();
    if ( !defined($val) ) {
        return \%parsed_session_cookie;
    }
    my $unescaped = uri_unescape($val);
    my @elts = split('~',$unescaped);
    for my $elt (@elts) {
        my ($k,$v) = split('===',$elt,2);
        $parsed_session_cookie{$k}=$v;
    }

    return \%parsed_session_cookie;
}

1;

# Local Variables:
# tab-width:4
# indent-tabs-mode:nil
# End:
